home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / jan93cad.zip / LISPMENU.LSP < prev    next >
Lisp/Scheme  |  1993-02-12  |  4KB  |  139 lines
  1. ; LISPMENU.LSP
  2. ; Copyright (c) Barry R. Bowen 1993
  3. ; __________________________________________________________
  4. ; Variables:
  5. ; CNT      = Counter
  6. ; FILE     = DCL file pointer
  7. ; FN       = DCL file name
  8. ; FNAME    = Complete DCL file name with path
  9. ; NKEY     = Keyword form key_word list
  10. ; KEY      = Keyword for program button label
  11. ; KEY_LIST = Keyword list from DCL file
  12. ; ----------------------------------------------------------
  13.  
  14. (defun C:LISPMENU (/ CNT FN FNAME FILE NKEY KEY KEY_LIST)
  15.   (defun WLF (LINE) (write-line LINE FILE))
  16.   (setq old_cmd (getvar "cmdecho")
  17.         old_error *error*
  18.         *error* ai_error)
  19.   (setvar "cmdecho" 0)
  20.   (while (not FN)
  21.     (setq FN (strcase (getstring "\nDCL Filename: "))
  22.        FNAME (strcat FN ".DCL"))
  23.     (if (not (findfile FNAME))
  24.       (progn
  25.         (setq FN nil)
  26.         (alert (strcat "File " FNAME " Does Not Exist!"))
  27.   ) ) )
  28.   (prompt "\nCreating LISP Program File....")
  29.   (setq FILE (open FNAME "r"))
  30.   (setq LINE (read-line FILE))
  31.   (setq key_list (list '()))
  32.   (while LINE
  33.     (if (wcmatch LINE "?*key*")
  34.       (progn
  35.          (get_key)
  36.          (setq key_list (append (list NKEY) key_list))
  37.     ) )
  38.     (setq LINE (read-line FILE))
  39.   )
  40.   (setq key_list (cdr (reverse key_list)))
  41.   (close FILE)
  42.   (setq FNAME (strcat FN ".LSP"))
  43.   (setq FILE (open FNAME "w"))
  44.   (WLF (strcat ";; " FNAME))
  45.   (WLF ";; Program For AutoLISP Dialog Box Menu")
  46.   (WLF "")
  47.   (WLF "")
  48.   (WLF (strcat "(defun C:" FN " (/ ai_defaults dcl_id old_cmd
  49.                        old_error PRG TILE what_next)"))
  50.   (WLF (strcat "  (defun " FN "_MAIN ()"))
  51.   (WLF 
  52. (strcat "    (if (not (new_dialog " (chr 34) FN (chr 34)
  53.                                         " dcl_id)) (exit))"))
  54.   (WLF 
  55. (strcat "      (action_tile " (chr 34) "accept" (chr 34)
  56.                      (chr 34) " (done_dialog)" (chr 34) ")"))
  57.   (WLF 
  58. (strcat "      (action_tile " (chr 34) "cancel" (chr 34)
  59.                      (chr 34) " (done_dialog)" (chr 34) ")"))
  60.   (setq CNT 0)
  61.   (setq KEY (nth CNT KEY_LIST))
  62.   (while (/= KEY nil)
  63.       (WLF 
  64. (strcat "      (action_tile " (chr 34) KEY (chr 34) " "
  65.                     (chr 34) "(setq PRG $key)" (chr 34) ")"))
  66.       (setq CNT (1+ CNT))
  67.       (setq KEY (nth CNT KEY_LIST))
  68.   )
  69.   (WLF "")
  70.   (WLF "  (setq what_next (start_dialog))")
  71.   (WLF "   (if (= 1 what_next)")
  72.   (WLF "    (progn")
  73.   (WLF 
  74. (strcat "  (if (assoc " (chr 34) FN (chr 34) " ai_defults)"))
  75.   (WLF (strcat "       (setq ai_defults (subst (list "
  76.                          (chr 34) FN (chr 34) " on_screen)"))
  77.   (WLF 
  78. (strcat "     (assoc " (chr 34) FN (chr 34) " ai_defaults)"))
  79.   (WLF "               ai_defaults")
  80.   (WLF "  )))))")
  81.   (WLF "  (do_action PRG)")
  82.   (WLF "  );end defun main")
  83.   (WLF "")
  84.   (WLF ";; Setup Error Function")
  85.   (WLF 
  86. (strcat "(setq old_cmd (getvar " (chr 34) "cmdecho" (chr 34) )"))
  87.   (WLF "     old_error  *error*")
  88.   (WLF "      *error* ai_error")
  89.   (WLF ")")
  90.   (WLF (strcat "(setvar " (chr 34) "cmdecho" (chr 34) " 0)"))
  91.   (WLF "(cond")
  92.   (WLF "   ((not (ai_notrans)))")
  93.   (WLF "   ((not (ai_acadapp)))")
  94.   (WLF 
  95. (strcat "   ((not (setq dcl_id (ai_dcl "(chr 34) FN (chr 34) ))))"))
  96.   (WLF (strcat "   (t (" FN "_MAIN))"))
  97.   (WLF ")")
  98.   (WLF "(setq *error* old_error)")
  99.   (WLF 
  100. (strcat "(setvar " (chr 34) "cmdecho" (chr 34) " old_cmd)"))
  101.   (WLF "(done_dialog dcl_id)")
  102.   (WLF "(princ)")
  103.   (WLF ")")
  104.   (WLF "")
  105.   (WLF "(defun do_action (PRG)")
  106.   (WLF "  (cond")
  107.   (setq CNT 0)
  108.   (setq KEY (nth CNT KEY_LIST))
  109.   (while (/= KEY nil)
  110.     (WLF 
  111. (strcat "    ((= PRG " (chr 34) KEY (chr 34) ") (load "
  112.                      (chr 34) KEY (chr 34) ") (c:" KEY "))"))
  113.     (setq CNT (1+ CNT))
  114.     (setq KEY (nth CNT KEY_LIST))
  115.   )
  116.   (WLF "))")
  117.   (WLF "")
  118.   (close FILE)
  119.   (setvar "cmdecho" old_cmd)
  120.   (setq *error* old_error)
  121.   (princ)
  122. )
  123.  
  124. (defun get_key (/ CK CNT SLS)
  125.   (setq SLS (- (strlen LINE) 3)
  126.         CK (substr LINE SLS 1)
  127.         CNT 1)
  128.   (while (/= CK (chr 34))
  129.      (setq SLS (- SLS 1)
  130.             CK (substr LINE SLS 1)
  131.            CNT (1+ CNT))
  132.   )
  133.   (setq SLS (1+ SLS))
  134.   (setq NKEY (substr LINE SLS CNT))
  135. )
  136. (prompt "\nAutoLISP Dialog Box Program Menu Loaded...")
  137. (prompt "\nType LISPMENU To Run.")
  138. (princ)
  139.